Packard Bell - Internet on a CD/internet on a cd.cdr/Internet/sites/Clementine_NASA/image.hqx/Image folder/Macros/Corpus Collosum Macros

Text File | 1991-06-19 | 4.1 KB | 202 lines

{
This is a set of macros for measuring the area of various regions in the corpus collosum in MRI scans. It assumes that the scans are 256x256, that you are using a 19" monitor, that the Clipboard buffer is set to 600K, and that you have a lot of RAM.

This is the procedure:

1) Open or activate the scan to be analyzed and type Z.
2) Draw a base line using the line tool.
3) Draw perpendicular lines by typing S or R.
4) Draw a perpendicular line at an arbitrary location by clicking
   on the base line with the line tool and typing A.
5) Outline the corpus collosum.
6) Threshold by typing B.
7) Measure the areas by clicking inside each region with the wand.
8) Revert to grayscale by typing G. (Optional)
9) Dispose of the 768x768 working window by typing D.
}

var  {Global variables}
  WindowNum:integer;
  x1,y1,x2,y2,LineWidth:integer;
  size,angle,dx,dy,pi,theta:real;
  width,height,dx,dy,i:integer;


macro 'Zoom Window [Z]';
var
  top,left,width,height:integer;
begin
  GetPicSize(width,height);
  if width>600 then begin
    PutMessage('Window has already been zoomed.');
    exit;
  end;
  KillRoi;
  WindowNum:=PicNumber;
  SetScaling('Nearest; New Window');
  ScaleAndRotate(3,3,0);
  ChangeValues(254,255,253); {Reserve 254-255(black) for graphics}
  SetForegroundColor(254);
  ApplyLUT;
  SetLineWidth(1);
end;


procedure DrawPerpendicularLine(x,y:integer);
begin
  moveto(x,height-y);
  lineto(x+size*cos(theta+angle),height-(y+size*sin(theta+angle)));
  moveto(x,height-y);
  lineto(x+size*cos(theta-angle),height-(y+size*sin(theta-angle)));
end;


procedure DrawLines(nSegments:integer);
begin
  for i:=1 to nSegments-1 do
    DrawPerpendicularLine(x1+round(i*dx/nSegments),y1+round(i*dy/nSegments));
end;


procedure DrawLeftLine;
var
  nSegments,i:integer;
begin
  nSegments:=5;
  i:=1;
  DrawPerpendicularLine(x1+round(i*dx/nSegments),y1+round(i*dy/nSegments));
end;


procedure DrawRightLine;
var
  nSegments,i:integer;
begin
  nSegments:=5;
  i:=4;
  DrawPerpendicularLine(x1+round(i*dx/nSegments),y1+round(i*dy/nSegments));
end;


procedure DrawThePerpendiculars;
begin
  GetLine(x1,y1,x2,y2,LineWidth);
  if (x1<0) or ((x2-x1)<10) then begin
    PutMessage('Select the base line first using the line tool.');
    exit;
  end;
  Fill;
  KillRoi;
  size:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
  angle:=90; {degrees}
  pi:=3.14159;
  GetPicSize(width,height);
  y1:=height-y1;
  y2:=height-y2;
  angle:=(angle/180)*pi;
  dx:=x1-x2;
  dy:=y1-y2;
  if dx=0 then begin
    if dy>=0 then theta:=pi/2 else theta:=3/2*pi
  end else begin
    theta:=arctan(dy/dx);
    if dx<0 then theta:=theta+pi;
  end;
  dx:=x2-x1;
  dy:=y2-y1;
  SetForegroundColor(255);
  DrawLines(2);
  DrawLines(3);
end;


Macro 'Draw Perpendicular Lines-Left[S]';
begin
  DrawThePerpendiculars;
  DrawLeftLine;
end;


Macro 'Draw Perpendicular Lines-Right[R]';
begin
  DrawThePerpendiculars;
  DrawRightLine;
end;


macro 'Draw Arbitrary Perpendicular Line [A]';
var
  xx1,yy1,xx2,yy2:integer;
  fraction:real;
begin
  if angle=0 then begin
    PutMessage('Draw the other perpendiclular lines first.');
    exit;
  end;
  if dx=0 then begin
    PutMessage('Draw base line first.');
    exit;
  end;
  GetLine(xx1,yy1,xx2,yy2,LineWidth);
  if not ((xx1>x1) and (xx1<x2)) then begin
    PutMessage('Click with the line tool first.');
    exit;
  end;
  KillRoi;
  fraction:=(xx1-x1)/dx;
  DrawPerpendicularLine(x1+round(dx*fraction),y1+round(dy*fraction));
end;


macro 'Make Binary [B]';
var
  top,left,width,height:integer;
begin
  GetRoi(top,left,width,height);
  if width=0 then begin
    PutMessage('Please outline first.');
    exit;
  end;
  DrawBoundary;
  KillRoi;
  SetThreshold(255);
  MeasureArea(true);
  MeasureDensity(false);
  LabelParticles(false);
  IncludeInteriorHoles(true);
  WandAutoMeasure(true);
  ResetCounter;
  ShowResults;
end;

macro 'Make Grayscale [G]';
begin
  ResetGrayMap;
  KillRoi;
end;

macro 'Dispose of Window [D]';
var
  width,height:integer;
begin
  GetPicSize(width,height);
  if width>600
    then dispose
    else exit;
  if windowNum<>0 then SelectPic(WindowNum);
end;

macro 'Adjust Areas [Q]';
var
  i:integer;
begin
  for i:=1 to rCount do
    rArea[i]:=rArea[i]/9;
  ShowResults;
end;